perm filename COMBNF.LSP[BNF,JRA] blob sn#045429 filedate 1973-05-24 generic text, type T, neo UTF8
01600	
01700	(DEFPROP >RTLST< 
01800	 (LAMBDA(%N)
01900	  (OUTRUL %N
02000		  (FUNCTION
02100		   (LAMBDA NIL
02200		    (COND ((EQ (QUOTE NIL) (STK1)) FOOBAZ)
02300			  ((AND (MATCH (QUOTE ((* (COMPILE . *)) . *))) (>RTPT< 2) (>SEXPR< 1) (>RTLST< 0))
02400			   (LIST (QUOTE (%IN 10))
02500				 (QUOTE (:CH :))
02600				 (QUOTE (:CH :))
02700				 (QUOTE (:CH =))
02800				 (STK2)
02900				 (QUOTE (:CH /[))
03000				 (STK1)
03100				 (QUOTE (:CH /]))
03200				 (QUOTE (%IN 0))
03300				 (STK0)))
03400			  ((AND (MATCH (QUOTE ((* *) . *))) (>RTPT< 2) (>SEXPR< 1) (>RTLST< 0))
03500			   (LIST (QUOTE (%IN 10))
03600				 (QUOTE (:CH :))
03700				 (QUOTE (:CH :))
03800				 (QUOTE (:CH =))
03900				 (STK2)
04000				 (STK1)
04100				 (QUOTE (%IN 0))
04200				 (STK0)))))))) 
04300	EXPR)


(DEFPROP <RTLST> 
 (LAMBDA NIL
  (NLRR (QUOTE RTLST)
	(FUNCTION
	 (LAMBDA NIL
	  (COND ((AND (CH :) (CH :) (CH =) (<RTPT>) (<SEXPR>) (<RTLST>))
		 (CONS (CONS (STK 2) (CONS (STK 1) NIL)) (STK 0)))
		((AND (CH :) (CH :) (CH =) (<RTPT>) (CH /[) (<SEXPR>) (CH /]) (<RTLST>))
		 (CONS (CONS (STK 4) (CONS (CONS (QUOTE COMPILE) (STK 2)) NIL)) (STK 0)))
		((AND) NIL)
		(*NIL*)))))) 
EXPR)

(DEFPROP STKIFY 
 (LAMBDA(X RTPT)
  (COND ((NULL X) NIL)
	((EQ X (QUOTE *)) (LIST (QUOTE STK) (GETATOM RTPT)))
	((MEMBER X RTPT) (LIST (QUOTE STK) X))
	((ATOM X) (LIST (QUOTE QUOTE) X))
	((EQ (CAR X) (QUOTE COMPILE)) (CDR X))
	(T (LIST (QUOTE CONS) (STKIFY (CAR X) RTPT) (STKIFY (CDR X) RTPT))))) 
EXPR)